home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / lsp / module.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1987-06-04  |  1.8 KB  |  67 lines
  1. ;; (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  2. ;; Copying of this file is authorized to users who have executed the true and
  3. ;; proper "License Agreement for Kyoto Common LISP" with SIGLISP.
  4.  
  5. ;;;;    module.lsp
  6. ;;;;
  7. ;;;;                            module routines
  8.  
  9.  
  10. (in-package 'lisp)
  11.  
  12. (export '(*modules* provide require))
  13. (export 'documentation)
  14. (export '(variable function structure type setf))
  15.  
  16. (in-package 'system)
  17.  
  18.  
  19. (eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
  20.  
  21.  
  22. (defvar *modules* nil)
  23.  
  24.  
  25. (defun provide (module-name)
  26.   (setq *modules*
  27.         (adjoin (string module-name)
  28.                 *modules*
  29.                 :test #'string=)))
  30.  
  31.  
  32. (defun require (module-name
  33.                 &optional (pathname (string-downcase (string module-name))))
  34.   (let ((*default-pathname-defaults* #""))
  35.     (unless (member (string module-name)
  36.                     *modules*
  37.                     :test #'string=)
  38.             (if (atom pathname)
  39.                 (load pathname)
  40.                 (do ((p pathname (cdr p)))
  41.                     ((endp p))
  42.                   (load (car p)))))))
  43.           
  44.  
  45. (defun documentation (symbol doc-type)
  46.   (case doc-type
  47.     (variable (get symbol 'variable-documentation))
  48.     (function (get symbol 'function-documentation))
  49.     (structure (get symbol 'structure-documentation))
  50.     (type (get symbol 'type-documentation))
  51.     (setf (get symbol 'setf-documentation))
  52.     (t (error "~S is an illegal documentation type." doc-type))))
  53.  
  54.  
  55. (defun find-documentation (body)
  56.   (if (or (endp body) (endp (cdr body)))
  57.       nil
  58.       (let ((form (macroexpand (car body))))
  59.         (if (stringp form)
  60.             form
  61.             (if (and (consp form)
  62.                      (eq (car form) 'declare))
  63.                 (find-documentation (cdr body))
  64.                 nil)))))
  65.  
  66.  
  67.